unit KRK.Components.DataControls.SOAPProvider;

interface

uses Provider, DBClient, XMLXForm, Classes;

type
  TOnBeforeSOAPGetRecords = procedure (const aTransformation: TXMLTransform) of object;
  TOnAfterSOAPGetRecords = procedure (const aTransformation: TXMLTransform) of object;
  TOnAddTopLevelNode = procedure (const aTransformation: TXMLTransform; const aTopLevelNodeOpen, aTopLevelNodeClose: String) of object;

  TGetRecordsOptions = class(TPersistent)
  private
    FTopLevelNode: String;
    FRequestEnvelope: TStrings;
    FServiceUrl: String;
    FUseSoap12: Boolean;
    FProxy: String;
    FPassword: String;
    FSOAPAction: String;
    FUserName: String;
    FXTR: TStrings;
    procedure SetXTR(const Value: TStrings);
    procedure SetRequestEnvelope(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property TopLevelNode: String read FTopLevelNode write FTopLevelNode;
    property ServiceUrl: String read FServiceUrl write FServiceUrl;
    property SOAPAction: String read FSOAPAction write FSOAPAction;
    property UseSoap12: Boolean read FUseSoap12 write FUseSoap12 default False;
    property UserName: String read FUserName write FUserName;
    property Password: String read FPassword write FPassword;
    property Proxy: String read FProxy write FProxy;
    property RequestEnvelope: TStrings read FRequestEnvelope write SetRequestEnvelope;
    property XTR: TStrings read FXTR write SetXTR;
  end;

//  TApplyUpdatesOptions = class(TPersistent)
//  private
//  published
//    property ServiceUrl: String read FServiceUrl write FServiceUrl;
//    property RequestEnvelope: String; const aSOAPAction: String = ''; const aUseSoap12: Boolean = False; const aUserName: String = ''; const aPassword: String = ''; const aProxy: String = ''
//  end;

  TKRKSOAPProvider = class(TCustomProvider)
  private
    FGetRecordsOptions: TGetRecordsOptions;
    FDataCache: TClientDataSet;
//    FResolver: TDataSetProvider;
    FTransformRead: TXMLTransform;
//    FTransformWrite: TXMLTransform;
    FCacheData: Boolean;
//    function GetXMLDataFile: string;
//    procedure SetXMLDataFile(const Value: string);
    FOnBeforeSOAPGetRecords: TOnBeforeSOAPGetRecords;
    FOnAfterSOAPGetRecords: TOnAfterSOAPGetRecords;
    FOnAddTopLevelNode: TOnAddTopLevelNode;
  protected
    function InternalApplyUpdates(const Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant; override;
    function InternalGetRecords(Count: Integer; out RecsOut: Integer; Options: TGetRecordOptions; const CommandText: WideString; var Params: OleVariant): OleVariant; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property GetRecordsOptions: TGetRecordsOptions read FGetRecordsOptions write FGetRecordsOptions;
//    property TransformRead: TXMLTransform read FTransformRead ;
//    property TransformWrite: TXMLTransform read FTransformWrite ;
//    property XMLDataFile: string read GetXMLDataFile write SetXMLDataFile;
    property CacheData: Boolean read FCacheData write FCacheData default False;
    property BeforeApplyUpdates;
    property AfterApplyUpdates;
    property BeforeGetRecords;
    property AfterGetRecords;
    property BeforeRowRequest;
    property AfterRowRequest;
    property OnDataRequest;
    property OnBeforeSOAPGetRecords: TOnBeforeSOAPGetRecords read FOnBeforeSOAPGetRecords write FOnBeforeSOAPGetRecords;
    property OnAfterSOAPGetRecords: TOnAfterSOAPGetRecords read FOnAfterSOAPGetRecords write FOnAfterSOAPGetRecords;
    property OnAddTopLevelNode: TOnAddTopLevelNode read FOnAddTopLevelNode write FOnAddTopLevelNode;
 end;

implementation

uses KRK.Lib.Rtl.Common.VariantUtils, KRK.Lib.Rtl.Common.SOAPUtils, XMLUtil;

//function CreateNestedTransform(Owner: TComponent; const Name: string): TXMLTransform;
//begin
//  Result := TXMLTransform.Create(Owner);
//  Result.SetSubComponent(True);
//  Result.Name := Name;
//end;

{ TSOAPProvider }

constructor TKRKSOAPProvider.Create(AOwner: TComponent);
begin
  FGetRecordsOptions := TGetRecordsOptions.Create;
  FTransformRead := TXMLTransform.Create(Self);
//  FTransformWrite := CreateNestedTransform(Self, 'DataTransformWrite'); // Do not localize
  FDataCache := TClientDataSet.Create(Self);
  inherited;
end;

destructor TKRKSOAPProvider.Destroy;
begin
  FDataCache.Free;
  FTransformRead.Free;
  FGetRecordsOptions.Free;
  inherited;
end;

//function TKRKSOAPProvider.GetXMLDataFile: string;
//begin
//  Result := FTransformRead.SourceXMLFile
//end;

//procedure TKRKSOAPProvider.SetXMLDataFile(const Value: string);
//begin
//  FTransformRead.SourceXMLFile := Value;
//end;

function TKRKSOAPProvider.InternalApplyUpdates(const Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer): OleVariant;
//var
//  S: string;
begin
//  if not Assigned(FResolver) then
//  begin
//    FResolver := TDataSetProvider.Create(Self);
//    FResolver.DataSet := FDataCache;
//    FResolver.ResolveToDataSet := True;
//    FResolver.UpdateMode := upWhereAll; //upWhereKeyOnly;
//  end;
//
//  if not FCacheData or not FDataCache.Active then
//    FDataCache.Data := OleVariantByteArrayFromString(FTransformRead.Data);
//
//  Result := FResolver.ApplyUpdates(Delta, MaxErrors, ErrorCount);
//  FDataCache.MergeChangeLog;
//  S := FTransformWrite.TransformXML(GetXMLData(FDataCache));
//
//  if FTransformWrite.ResultDocument <> nil then
//  begin
//    SetEncoding(FTransformWrite.ResultDocument, FTRansformRead.FEncoding, False);
//    if FTransformRead.SourceXmlFile <> '' then
//      (FTransformWrite.ResultDocument as IDOMPersist).save(FTransformRead.SourceXmlFile);
//  end
//  else if S <> '' then
//    StringToFile(S, FTransformRead.SourceXmlFile);
//
//  if not FCacheData then
//    FDataCache.Data := Null;
end;

function TKRKSOAPProvider.InternalGetRecords(Count: Integer; out RecsOut: Integer; Options: TGetRecordOptions; const CommandText: WideString; var Params: OleVariant): OleVariant;
begin
  if Assigned(FOnBeforeSOAPGetRecords) then
    FOnBeforeSOAPGetRecords(FTransformRead);

  FTransformRead.SourceXml := SOAPRequest(FGetRecordsOptions.ServiceUrl
                                         ,FGetRecordsOptions.RequestEnvelope.Text
                                         ,FGetRecordsOptions.SOAPAction
                                         ,FGetRecordsOptions.UseSoap12
                                         ,FGetRecordsOptions.UserName
                                         ,FGetRecordsOptions.Password
                                         ,FGetRecordsOptions.Proxy);

  if Assigned(FOnAddTopLevelNode) and (FGetRecordsOptions.TopLevelNode <> '') then
    FOnAddTopLevelNode(FTransformRead
                      ,'<' + FGetRecordsOptions.TopLevelNode + '>'
                      ,'</' + FGetRecordsOptions.TopLevelNode + '>');


  if Assigned(FOnAfterSOAPGetRecords) then
    FOnAfterSOAPGetRecords(FTransformRead);

  FTransformRead.TransformationDocument := LoadDocFromString(FGetRecordsOptions.XTR.Text);

  Result := OleVariantByteArrayFromString(FTransformRead.Data);

  if CacheData then
    FDataCache.Data := Result;
end;

{ TGetRecordsOptions }

constructor TGetRecordsOptions.Create;
begin
  FServiceUrl := '';
  FUseSoap12 := False;
  FProxy := '';
  FPassword := '';
  FSOAPAction := '';
  FUserName := '';
  FTopLevelNode := '';

  FRequestEnvelope := TStringList.Create;
  FXTR := TStringList.Create;
end;

destructor TGetRecordsOptions.Destroy;
begin
  FXTR.Free;
  FRequestEnvelope.Free;
  inherited;
end;

procedure TGetRecordsOptions.SetRequestEnvelope(const Value: TStrings);
begin
  FRequestEnvelope.Assign(Value);
end;

procedure TGetRecordsOptions.SetXTR(const Value: TStrings);
begin
  FXTR.Assign(Value);
end;

end.
